home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / STRIP-PATHNAME < prev    next >
Encoding:
Text File  |  1990-08-31  |  1.3 KB  |  46 lines
  1.  
  2. \ Mike Haas, Delta Research
  3.  
  4. \ this word has come in handy ... it take the ( adr cnt -- )
  5. \ of a forth-string-style pathname, and returns  ( -- adr cnt )
  6. \ of just the filename.  If there is just a filename to start,
  7. \ the string arguments are untouched.
  8. \
  9. \ 10/17/87 mdh Added 'Strip-Filename'
  10. \ MOD: PLB 8/29/90 Fixed STRIP-PATHNAME which used to look past
  11. \      end of string.  This now works.
  12. \      " RAM:TEST/" COUNT 1- STRIP-PATHNAME TYPE
  13.  
  14. : STRIP-PATHNAME  ( addr cnt -- addr' cnt' , strip any additional 'pathname' )
  15.   2dup
  16.   2dup +     ( -- adr cnt adr cnt LastAdr+1 ) 1- swap 0
  17.   DO ( -- adr cnt adr LastAdr )
  18.        dup c@  dup ascii / =   ( -- adr cnt adr LASTadr char flag )
  19.        swap ascii : =  or
  20.        IF LEAVE
  21.        ELSE 1-
  22.        THEN
  23.   LOOP ( -- adr cnt adr FinalAdr )  swap -  1+ >r
  24.   r@ -  swap  r> + swap
  25. ;
  26.  
  27.  
  28. : STRIP-FILENAME  ( adr cnt -- adr cnt' )
  29. \
  30. \ Remove the trailing name, and the '/' if remaining string ends in a dir...
  31. \ If no obvious volume or dirname is seen, returned count = 0.
  32. \
  33. \ Examples:   JForth:util/asm    returns    JForth:util
  34. \             JForth:util        returns    JForth:
  35. \             util/              returns    util
  36. \             util               returns
  37. \
  38.   2dup  Strip-Pathname  swap drop   -   dup
  39.   IF
  40.      ( -- adr cnt )  2dup 1- + c@ ascii / =
  41.      IF
  42.         1-
  43.      THEN
  44.   THEN
  45. ;
  46.